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# ! /usr/bin/perl 
use strict; 

#Correl_Display_l_6_l . pi 

#Designed to take the CVS formatted exported file from Omni Vis and produce a nice PNG 

# image similar to that on the screen in Omni Viz 
#New in Version 1.1: 

# Inclusion of clinical data!; 
use GD; 

$ | =1 ; #Do not use output buffer - print cliag immediately 

######################## 

#Global Variable decision area: 

my %Config; #Main Configuration hash, 

my $Top_Color=0 ; 

#my $Block_Size » 10; #The size (in Pixels) of each block. 

#File names: Hard Wired in version 1_1! 

#my $Clinical_Data_File = " . /Klinisch_data_AML.csv" ; #The name of the Clinical 

Datafile (Comma delimited format) . 

#my $Output_Pile = "Output .png" ; #Name of the 

final generated image. 



#Other parameters: 
#my $Block_Iiines 
the blocks 

dimensions 

#my $Draw_Key_F 

#ray $Color_Strips = 40 

#my $ Mini mum = -1 

#my $Maximum = +1 

#ray $Scale =5; 
of the Blocks in the Color Stripe 



« "F"; #Whether to draw lines round the (inside) of 

#NB: Reduces colored area by 1 pixel in both 

= "T" ; #Should a Key be prepared? 

#The number of intervening colors in the 'Strip' 

#Assumed minmum of correlation data. 

# Assumed minmum of correlation data. 

#The multiplication factor for relative to $Block_jSize 



######################## 
Load_Conf iguration () ; 



#Load configuration from STDIN 



########################File acceptance testing######################## 

$Conf ig{Correlatian_File} = shift ©ARGV; #Pull filename from ARGV 

$Config{Output_File} = shift ©ARGV; 

if ( ($Config{Correlation_File} eq »-) or ! (-e $Conf ig{Correlation_File} ) ) tfCheck file 
exists (and is not blank!) 

{die "Please enter valid Correlation file name: \n' w , $Conf ig{Correlation_File} , " 1 
Appears to be invalid\n" ; } 
if ($Config{Output_File} eq 

{warn "Output filename not specified: defaulting to » Output .png 1 (all previous files 
of same name will be over written) Hit !!!Ctrl-CM! NOW to avoid\n M } 



open IP_FILE, $Conf ig{Correlation_File} or #Open input file or exit with error 

die "Cannot open ' " , §Config{ Correlation File} , M 1 \n for some reason\n" ; 

########################Declare useful variables######################## 

my ©IDs ; #Global - for when we find them. 

my $Row=0; #Need this for later when loading data. 

my $Max_Col=-l; #Used more as a security check than actually in processing, 

my ©Matrix; #Main Matrix loaded. 

my %Patient_ID; #Hash array to store the patient IDs : Used to linke the CC & 

Clinical data 

########################Load data from Correlation Matrix f ile######################## 
while (<IP_FILE>) 

{ 

chomp () ; #Remove end of line char 

$_ =- s/[\n\rj//g; 

if ($_ eq "■) {next;} #ln case there are any blank lines 

unless (A,/) (die "Errr. There is a distinct lack of commas on this line... of the 
Correlation_File : 1 $Conf ig{Correlation_File} , 0 1 :\n» ■ , substr ($_, 0,20) , ■ ' \n" ; } 

my ©Fields = split (", ",$_); #Split on Commas (it is a Comma delimited file); 

if (/^Variables/) #Ie. The first line with the "names" of the 

rows/colums . 

{ 

shift ©Fields; #Strip the 'Variables' part off- 
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# print 0 @Fields\n tt ; 

©IDs - ©Fields; #Take of copy of the '©Fields' Array which is Locally 

scoped 

next; #Skip to next line 

} 

my $Patient_ ID = shift ©Fields; #Strip the 'Patient' part off the front of each 

line . 

# print °D: Loading CC data for patient ID: ' $Patient_ID • \n" ; 
$Patient_ID{$Row} = $Patient_ID; 

if ($Patient_ID =- m/b$/) 

{ 

print °D: Detected «b' suffix Patient: ' $Patient_ID ' Corrected to:"; 
$Patient_ID =~ s/b$//; 
print ■ '$Patient_ID« \n ta ; 

} 

if ($#Fields $Max_Col) #Check consistent number of Coloums reported 

{ 

if ($Max_Col mm -1) 
{ 

$Max_Col - $#Fields; # Wasteful to do this every time., 
print n D : Setting Max_Col to: ' $Max_Col ' \n" ; 

} 

else 

{ 

print "D: Warning: Number of Coloums Deviation: Row '$Row' (has 
' $#Fields' coloums, previous ones had ' $Max_Col ' \n" ; 



foreach my $C_Col (0 . . $#Fields) 

{ 

$Matrix[$Row] [$C Col] = $Fieldst$C Col] ; 
} 

$Row++ ; 

} 

print "D: Matrix is: [Rows x Coloums] : $Row x $Max_Col\n° ; 

print "D: Or to put it another way: " , $#Matrix, « x ■ , $#{$Matrix [0] } , "\n" ; 

print »D: Matrix Test cell = 0,0 « $Matrix[0] [0] \n D: Matrix Test cell 1,0 - $Matri>c [1] [0] 
D: Matrix Test cell 303,303 = $Matrix[302] [302] \n" ; 

print "D: We are using clinical data file: 1 $Conf ig{ciinical_Data__File} ' \n M ; 
open CI»IN_FILE, $Conf ig{Clinical_Data_File} or 

die "Cannot open clinical datafile: 1 " , $Conf ig{Clinical_Data_File} , u 1 for some 
reason\n" ; 

my $ CI i ni cal_Da t a__Col_HeaderJText_l ; 

my $Clinical_Data_Col_Header_Text_2 ; 

my $Clinical_Data_Col_Header_Text_3 ; 

my $Clinical_Data_Col_Header_Text_4 ; 

my $Clinical_Data_Col_ Header_Text_5 ; 

my $Clinical__Data_Col_Header_Text_6 ; 

my $ Cl i ni cal_Da t a_Col_He ader_Text_7 ; 

my $Clinical_Data_Col_Header_Text_8 ; 

my $Clinical_Data_Col_Header__Text_9 ; 

my $Wanted_Header_Col_ Index_l; 

my $ W an t ed_He ade r_Co l_Index_2 ; 

my $Wanted_Header_Col_Index_3 ; 

my $Wanted_Header_Col_Index__4 ; 

my $Wanted_Header_Col_Index_5 ; 

my $Wanted_Header_Col_Index_6 ; 

my $Wanted_Header_Col_Index_7; 

my $ Want ed_Heade r_Col__Index_8 ; 

ray $ Want ed_He ade r_Co l_Index_9 ; 

my %Classif ication_l; 

my %Classif ication__2; 

my %Classif ication_3; 

my %Classif icationjl ; 

my %Classif ication_5 ; 

my %Classif ication_6 ; 

my %Classif ication_7 ; 

my %Classif ication 8 ; 
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ray %Classif ication_9; 
while (<CLIN_PIliE>) 

{ 

chomp ( ) ; #Death to New Line characters 1 ( ; - ) 

unless </\,/) {die "Errr. There is a distinct lack of commas on this line of the 

Correlation_File: ' " , $Conf ig{Correlation_File} , Bl :\n in , substr ($_, 0, 20) , " ■ \n" ; } 

my ©Fields = split (",",$_); 

if (/^Volgnummer/) #Match the Header line: 
{ 

print n D: • $_ , \n°; 

# ©Clinic a l_Data_Col_Headers = ©Fields; #i.e. just copy the comma -split 

line 

#Run through all column headers to find the index of the one we are looking for: 

foreach ray $C Column (0.. scalar (©Fields)) 

{ 

if ( $Fields £ $C__Column] eq $Conf ig{Header_Col_l} ) #Scan across the 
header line for column we want #1 

{ #Whoppie ! Found the one we want ! 

$Wajated_Header_Col_Index__l - $C_Column; 

$C1 inical_Data_Col_He ader_Text_l = $Conf ig { Header_Col_l } ; 
#Only now will we add it. 

print "D: Found the Coloumn [1] in the header we are looking 
for ! : Index is : 1 $Wanted__Header_Col_Index_l « \n" ; 

next; #There is (we assume) only one unique coloumn name. . . 

} 

if ($Fields [$C__Column] eq $Conf ig{Header_Col__2) ) #Scan across the 
header line for column we want #2 

{ #Whoppie! Found the one we wantl 

$Wanted_Header__Col__Index_2 = $C_Column; 

$C1 ini cal_Dat a__Col_Header_Text_2 = $Conf ig { Header__Col_2 } ; 
#Only now will we add it. 

print U D: Found the Coloumn [2] in the header we are looking 
for!: Index is: • $Wanted_Header_Col_Index_2 1 \n M ; 

$C1 ini cal_Data_Col_Header_Text_2 = ~ s/,/\./g; #Some t imes 

being Dutch is cute, othertimes its just plain annoying. . .Ja? 

next; #There is (we assume) only one unique coloumn name... 

) 

if ($Fields [$C_Column] eq $Conf ig{Header_Col_3} ) #Scan across the 
header line for column we want #1 

{ #Whoppie! Found the one we wantl 

$Wanted_Header_Col_Index_3 = $C__Column; 

$Clinical_Data_Col_Header_Text_3 = $Conf ig{Header_Col_3 } ; 
#Only now will we add it. 

print M D: Found the Coloumn [3] in the header we are lookiing 
for!: Index is: 1 $Want ed_Heade r_Co 1_I ndex_3 1 \ n " ; 

next; # The re is (we assume) only one unique coloumn name... 

if ($Fields[$C_Column] eq $Conf ig{Header_Col_4} ) #Scan across the 
header line for column we want #1 

{ #Whoppie! Found the one we want! 

$Wanted_Header_Col_Index_4 = $C_Column; 

$C1 ini cal_Dat a_Col_HeaderJText_4 = $Conf ig { Header_Col_4 } ; 
#Only now will we add it. 

print M D: Found the Coloumn (4 J in the header we are lookiing 
fori: Index is: • $Wanted_Header_Col_Index_4 » \n" ; 

next; #There is (we assume) only one unique coloumn name... 

if ($ Fields [$C_Column] eq $Conf ig{Header__Col_5} ) #Scan across the 
header line for column we want* #1 

{ #Whoppie 1 Found the one we want ! 

$Wanted_Header_Col_Index__5 » $C_Column; 

$Clinical_Data__Col_Header_Text_5 => $Conf ig{Header_Col_5} ; 
#Only now will we add it. 

print "D: Found the Coloumn [5] in the header we are looking 
fori: Index is: 1 $Wanted_Header_Col_Index_5 ■ \n" ; 

next; #There is (we assume) only one unique coloumn name... 

} 

if ($ Fields [$C_Column] eq $Conf ig{Header_Col_6} ) #Scan across the 
header line for column we want #1 

{ #Whoppie! Found the one we wantl 

$Wanted__Header__Col_Index_6 « $C_Column; 
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$Clinical_Data_Col_Header_Text_6 = $Conf ig{Header_Col_6} ; 
#Only now will we add it . 

print *D: Found the Coloumn [6 J in the header we are looking 
for ! : Index is : 1 $Wanted_Header_Col_Index_6 1 \n" ; 

next; #There is (we assume) only one unique coloumn name 

if ($Fields C$C_Column] eq $Conf ig{Header_Col_7} > #Scan across the 
header line for column we want #7 

{ #Whoppie! Found the one we wantl 

$Wanted_Header_Col_Index_7 = $C_Column; 

$C1 inical_Dat a_Col__Header_Text_7 ■ $ Conf ig { Header_Col_7 } ; 
#Only now will we add it. 

print "D: Found the Coloumn £7] in the header we are looking 
fori : Index is : • $Wanted__Header_Col_Index_7 ' \n" ; 

next; #There is (we assume) only one unique coloumn name... 

if ($ Fields [$C_Column] eq $Conf ig{Header_Col_8} ) #Scan across the 
header line for column we want #7 

{ #Whoppie! Found the one we want! 

$Wanted__Header_Col_Index_8 = $C_Column; 

$C1 inical_Da t a_Col_Headerjrext_8 = $Conf ig { Header_Col_8 } ; 
#Only now will we add it. 

print "D: Found the Coloumn [8] in the header we are looking 
for ! : Index is : 1 $Wanted_ - Header__Col_Index_8 ' \n n ; 

next; #There is (we assume) only one unique coloumn name... 

} 

if ($Fields [$C_Coluran] eq $Conf ig{Header_Col_9} ) #Scan across the 
header line for column we want #7 

{ #Whoppie! Found the one we want! 

$Wanted_Header_Col_Index_9 = $C_Column; 

$Clinical_Data_Col_Header_Text_9 = $Conf ig { Header_Col_9 } ; 
#Only now will we add it. 

print °D: Found the Coloumn [9] in the header we are looking 
fori: Index is: • $Wanted_Header__Col_Index_9 1 \n" ; 

next; #There is (we assume) only one unique coloumn name... 
} 



} 

if ($Clinical_Data_Col_Header_Text_l eq "") #I.e., nothing was set... 
{die "Opps.\nI was looking for the column header: 
• « , $Conf ig{Header_Col_l} , « ' in the clinical data file : ' " , $Conf ig{Clinical_Data_File} , n » \nl 
didn't find it!\nWhat I did find was: 1 ■» , join ( " ; ■ , ©Fields) , » 1 if that helps ... \n" ; } 

if ($Clinical_Data_Col_Header_Text_2 eq ,,n ) #I.e., nothing was set... 
{die °Opps.\nI was looking for the column header: 
* B ,$Config{Header_Col_2}, »' in the clinical data file: 1 " , $Coiif ig{Clinical_Data_File} , '» ' \nl 
didn't find itl\nWhat I did find was: 1 join ( » ;«, ©Fields) , » ' if that helps ... \n« ; } 

if ($Clinical_Data_Col_Header_Text_3 eq "") #I.e., nothing was set... 
{die "Opps.\nI was looking for the column header: 
1 « , $Conf ig{Header_Col_3 } , " ' in the clinical data file : ■ " , $Conf ig{Clinical_Data_File} , » ' \nl 
didn 1 1 find it ! \nWhat I did find was : ■ " , join ( " ; n , ©Fields) , " ' if that helps . . . \n" ; } 

if ($Clinical_Data_Col_Header_Text_5 eq ■") #I.e. , nothing was set 

{die *»Opps.\nI was looking for the column header: 
• ■ , $Conf ig{Header_Col_5 } , ■ ' in the clinical data file : • ■ , $Conf ig{Clinical_Data_File} , " 1 \nl 
didn't find it!\nWhat I did find was: ,n ,join (»;», ©Fields) , '" if that helps ... \n" ; } 

if ($Clinical_Data__Col_Header_Text_7 eq "") #I.e., nothing was set... 
{die "Opps.\nl was looking for the column header: 
1 ■ , $Conf ig{Header_Col_7 } , n > in the clinical data file : 1 n , $Conf ig{ciinical_Data__File } , « ' \nl 
didn 1 1 find it 1 \nWhat I did find was : • " , join ( n ; " r ©Fields) , " 1 if that helps . . . \n" ; } 

if ($Clinical_Data_Col_HeaderjText_B eq "") #I.e., nothing was set... 
{die °ppps.\nl was looking for the column header: 
• n ,$Config{Header_Col_B}, ■■ in the clinical data file: $Config{ Clinical Data_File} , ■ 1 \nl 
didn't find it!\nWhat I did find was: ,n ,join ( n j°, ©Fields) , " 1 if that helps ... \n" ; } 

if ($Clinical_Data_Col_Header_Text_9 eq "") #I.e., nothing was set... 
{die n Opps.\nI was looking for the column header: 
• ■ , $Conf ig{Header_Col_9} , » ■ in the clinical data f ile : 1 " , $Conf ig{ciinical_Data_File} , " ' \nl 
didn»t find it!\nWhat I did find was: ,n ,join («,-» , ©Fields) , " ' if that helps ... \n« ; } 
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next ; line have found the Coloumn thatn we are looking for ... so skip 

to next line. 

} 

# print D D: Loading Clinical Classification for Patient: '$Fields[0] ' this 
is: ' $Fields [$Wanted_Header_Col_Index_ll » & : « $ Pie Ids [$Wanted.__Header_Col_Index_2] 1 &: 
1 $Fields[$Wanted_Header_Col_Index_3] 1 &: •$ Fie Ids [$ Want ed_He*ade r_Col_Index_4] 1 &: 
»$Fields[$Wanted__Header__Col_Index_5] ' \n" #The first field contains the header 
Patient ID. . . 

# if (exists $Classif icat ion {$ Fields [$Wanted_Header_Co3__Indexl }) 

# [#We already have one of these! 

# die "Error! Patient IDs are not unique 1 \nThi s one 

# ■ , $Classif ication{$Fields [$Wanted_Header_Col_IndexJ } , ■ • f ou^nd for the 2nd time I n ; 



} 

$Clas si fication_l{$ Fields [0] 
$Clas si f ication_2 {$ Fields [0] 
$Classif ication_3 {$Fields [0] 
$Classif ication_4 { $Fields [0] 
$Classif ication_5 { $Fields [0] 
$Classif ication_6 { $Fields [0] 
$Classif ication_7 { $Fields [0] 



# 

want : 



$ Fie 1 ds [ $Want ed_Header_Col_Index_l ] 
$ F i e 1 ds [ $Want ed_He ad<s r_Col_i ndex 2 ] 
$Fields [ $Wanted_Headsr_Col_Index_3 ] 
$Fields [ $ Want ed_He ade r__Col_JE ndex_4 ] 
$Fields [$Wanted_Header_Col__Index__5 ] 
$ Fi elds [ $Wanted_HeadeBr_Col_Index_6 ] 
$Fields [ $Wanted_Header__Col_Index_7 ] 
$Fields [$Wanted_Header__Col_Index_8 ] 
$ Fields [ $Wanted_Header_Col_Index_9 ] 

#We know 



which column we 



$Classif ication_8 { $Fields [u] 
$Classif icat ion_9 {$ Fields [0] 

push ©Classification, $Fields[ $ Wan t ed_He ade r_Col_I ndesx] 
so just add this one. . . 

} 

########################Prepare colors####################tf#= ## 
#$ Image -> f illedRec tangle ($xl, $yl, $x2+20*$Catergory+$Coii-±" ig{Block_Size} 
$Block_color) ; 

#This last expression is so that all the bars will fit on! The 800 is a guess! 

my $Width = $Conf ig{Block_Size} * $Row + <$Conf ig{Block_Sizei } + $Conf ig { Gr aph__Space } 

my $Height = $Conf ig{Block_Size} * $Max_Col; 

#Create Image canvases & Allocate basic colors to them: 



$y2. 



8) 



my $Image •=» new GD:: Image ($Width , $Height) ; ^Create main image 'Canvas' 

my $White = $Image -> colorAllocate (255,255,255); #Set first color (also background 
color 1 ) 

Top_Color_Print ( ) ; 

#my $Blue = $Image -> colorAllocate (0,0,255); tf= Allocate color 'Blue*; 

#my $Red = $Iraage -> colorAllocate (255,0,0); #=Allocate color 'Red'; 

my $Black= $Image -> colorAllocate (0,0,0); #Allocat^ color 'Black'; 

Top_Color_Print ( ) ; 

my $Col_Stripe_Width = $Conf ig{Block_Size} * $Conf ig{Scale} * ($Conf ig{Color_S trips }+l) ; 

my $Col_Stripe_Height = $Conf ig{Block_Size} * $Config{ Scale} ; 

print n D: Color Stripe will be ($Col_Stripe_Width x $Col__Strripe_Reight) \n" ; 

my $Color_Stripe_IMG = new GD : : Image ($Col_Stripe_Width, $Col_Stripe_Height) ; 

$Color_Stripe__IMG -> colorAllocate (255,0,255); #Set firsst color (also background 

color! ) 



my $Title_Bar = new GD:: Image ($ Width , 100); 

$Title_Bar -> colorAllocate (255,255,255); #Set first coloarr (also background color!) 
#my $Blue = $Image -> colorAllocate (0,0,255); Allocate color 'Blue'; 

#my $Red = $Image -> colorAllocate (255,0,0); #=Allocate color 'Red'; 

$Title_Bar -> colorAllocate (0,0,0); #Allocate color 'Black 1 ; 

my $Patient_IDs » new GD:: Image (400, $Height) ; 

$Patient__IDs -> colorAllocate (255, 255, 255) ; #Set first colorr (also background color!) 

#my $Blue = $Image -> colorAllocate (0,0,255); #=Allocate color 'Blue'; 

#ray $Red « $Image -> colorAllocate (255,0,0); tf=Allocate color 'Red'; 

$Patient_IDs -> colorAllocate (0,0,0); #Allocat« color 'Black'; 

#my $Image = new GD: : Image (1000,100); #HW: For testing Color Stripe... 

my ©Co lor_S tripe; 

#Colors run: Full Blue - Partial Blues - Full white - Partia-1 Reds - Full Red 
print n D: Allocate 'Blues' : \n"; 

foreach my $C_Color (0 . . ($Conf ig{Color_Strips} /2-1) ) tf=Run: Full Blue to one level 

below white 

{ 

printf ("%3i - , $C_Color ) ; 
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my $Blue_level = 255/ ($Conf ig{Color_Strips}/2) *$C_Color; #The (complex) 
calculation for the color level 

print "D: Allocating Color: Blue_level = ' $Blue_level 1 \n B ; #works for the 

red as well but without the "255-" part 

push ©Color_Stripe , $Image -> colorAllocate ($Blue_level, $Blue_level, 255) ; 

# $Color_Stripe_ IMG -> colorAllocate (255, $Blue_level, $Blue_level) ; 

Top_Color_Print ( ) ; 

} 

#print "D: $# Col or_St ripe , @Color_Stripe\n" ; #Note down 

the index of the color just allocated in a 1 look-up' table 
#print "D: Allocating White: < As mid point >"; 

push ©Color_Stripe, $Image -> colorAllocate (255,255,255); #The 'White' is fixed. 
#$ColorjStripe__IMG -> colorAllocate (255,255,255); 
#Top__Color_Print ( ) ; 

#print n D: $#Color__Stripe, ®Color_Stripe\n" ; 
print n \nD: Allocate 'Reds' : \n"; 

foreach my $C_Color (1 . . ($Conf ig{Color_Strips}/2) ) #Run: one above 'white' to full red 
{ 

printf ("%3i ■ , $C_Color) ; 

my $Red_level = 255 - 255/ ($Conf ig{Color_Strips} /2) *$C__Color ; 
print "D: Red_level = ' $Red_level ' \n" ; 

push ©Color_Stripe , $Image -> colorAllocate (255 , $Red_level , $Red_level) ; 

# $Color_Stripe_IMG -> colorAllocate (255, $Red_level , $Red_level) ; 

# Top_Color_Print ( ) ; 

} 

print "\n"; 

#print "D: $#Color_Stripe, @Color_Stripe\n" ; 
print "D : Strip Colors » ' @Color_Stripe 1 \n" ; 

########################Build array image################### 
# Bui Id array 

my $ Range =sqrt ( ($Config{ Maximum} - $Conf ig{ Minimum} ) ** 2); #Ok, so we know that for 

Pearson CC it will be 2 

my $BINS = $#Color_S tripe +1; 

my $Bin_ width= $Range / $BXNS; 

print "D: Possible BINS = '$BINS'; For Range '$Range», so each bin is: '$Bin_width' 
wide\n" ; 

print "D: Building Array : \n" ; 
print "D: ■ ; 

foreach my $row (0 . . $#Matrix) #Cycle through all rows 

{ 

foreach my $col (0 . . $Max_Col) #Cycle through all coloumsn 

{ 

if ($row.==a $col) {last;} 

ray ($xl, $x2 , $yl, $y2, $color) ; #Declare Intermediate variables 

my $value = $Matrix [$rowJ [$col] - $Config{ Minimum} ; #Re- center the 

data scale to +ve 

# print M D : value » «$value' "; 

#Calculate the color required using the same indices as lodged @Color_Stripe (NB: 
Color_Stripe need not exist by this stage: OPTIMISES AWAY?) 

$color = int ($value / $Bin_width) +1 +1; #The extra ' +1* is becaa 

# print "\nD: Matrix Color = $color, \n"; 

# $bin = int ($value 1) * (1/ $Color_S trips +1) ; 

# print "D: Bin « • $color '\n"; 

if { $color >= $BINS) {$color = $BINS;} 

$xl = $Conf ig{Block_Size} * $col; $x2 = $xl + $Conf ig{Block_Size} -1 ; 
#Top left to Bottom right of a square 

$yl » $Config{Block_Size} * $row; $y2 = $yl + $Conf ig{Block_Size} -1 ; 

# die "HIT BLOCK"; 

# print "D: xl = $xl, x2 = $x2 ; yl = $yl ; y2 = $y2\n" ; 

if ($Patient_ID{$row} eq $Conf ig{Marked_Patient} ) # print "D: value = 

' $value ' \n" ; 

{$color=$Black; } 

$Image -> f illedRectangle ($xl, $yl , $x2 , $y2, $color) ; #Actually draw 

the square at the correct location 

# $ Image -> rectangle ($xl, $yl, $x2-l, $y2-l, $Black) ; ^Outline the square 

} 

printf C%5i »,$row); #Just a counter printed to the screen / stream. 

# die "HIT BLOCK\n" ; 

} 
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print B \n°; 

if <$Config{Block_Iiines} eq tt T°) #Did the user request lines? 

{ 

Draw_I*ines on Image () ; 

} ~ " 

my $ Classes; my $Class_Lowest_Color; 

if ($Config{Mark_Patient_Data} eq n Y°) 
{ 

($Class_Lowest_Color, $Classes) = Mark_Patient_pata () ; 

} 

print n D: Classes Returned = ^Classes 1 ; number of colors needed: 
1 ■ , $Class_Lowest__Color , " 1 \n" ; 

#ray $Classif ication_Stripe_JEMG = new GD : : Image ($Conf ig{Block_Size} * $Classes * 
$Conf ig{ Scale} , $Conf ig{Block_Size} * $Config {Scale} ) ; 

####################################### Invoke Draw_Key () if necessary 
if ($Config {Draw_Color — Stripe} eq w T d ) 

{ 

Draw_Color_S tripe () ; 

} 



#Combine the images and write them out: 

my $Parent_Image = new GD: : Image ($Width + 100, $Height + 200); #Create final 

image ' Canvas 1 into which others are merged 

ray $White = $Parent_Image -> colorAllocate (255,255,255) ,* #Set first color (also 

background color 1) 

my $Black = $Parent_Image -> colorAllocate (0,0,0); #Formally allocate color 

• Black » 

my $Patient_ID_Width » 250; 

$Parent_Image -> copy ($lmage, $Patient_ID_Width, 100, 0, 0, $Width r $Height) ; #Merge the 
main heat-map / Patient Data. 

$Parent_JEraage -> copy ($Patient_IDs, 0,100, 0,0, $Patient_ID_Width, $Height) ; #Merge the 
Patient IDs 

$Parent_Iraage -> copy ($Color_Stripe_IMG, ($Width - $Col_Stripe_Width) /2 + 
$Patient_ID_Width, $Height + 100 + 100 - $Col_Stripe_Height , 0, 0, $Col__Stripe_Width, 
$Col_Stripe_Height+l) ; 

$Parent_Iraage -> stringTTF ($Black, » . /f onts/arial . ttf " , 30, 0, 

($Width - $Col_Stripe_Width) /2 + $Patient_ID_Width - 40, 
$Height + 100 + 40 + ($Conf ig{Block_Size} * $Config{ Scale } ) /2, 
"-l"); 

$Parent_Image -> stringTTF ($Black, " . /f onts/arial . ttf ° , 30, 0, 

$Width / 2 + 100 - 10, 

$Height + 100 + 40 + ($Conf ig{Block_Size} * $Config {scale } ) /2, 
"0"); 

$Parent_Image -> stringTTF ($Black, /f onts/arial . ttf " , 30, 0, 

($Width - $Col_Stripe_Width) /2 + $Patient_ID_Width + 

$Col_Stripe_Width , 

$Height + 100 + 40 + ($Conf ig{Block__size} * $Config {Scale } ) /2, 
n +l*); 

my $xl=0 ; 

$Title_Bar -> stringTTF ($Black, ". /f onts/arial .ttf n , 30, 0, 

$xl, 90, °FAB") ; 
$xl » $xl +$Conf ig{Graph_Space} ; 

$Title_Bar -> stringTTF ($Black, ■ . /f onts/arial .ttf " , 30, 0, 

$xl, 90, »WBC°); 

$xl = $xl +$Conf ig{Graph_Space} ; 

$Title_Bar -> stringTTF ($Black, ■ ./f onts/arial .ttf ■ , 30, 0, 

$xl, 90, "FI/T3 ITD tt ); 

$xl » $xl + $ Conf ig { Gr aph_Spa c e } ; 

$Title_Bar -> stringTTF ($Black, /f onts/arial . ttf n , 30, 0, 

$xl, 90, "OS"); 

$xl => $xl +$Conf ig{Graph_Space) ; 

$Title_Bar -> stringTTF ($Black, ». /f onts/arial .ttf n , 30, o# 
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$xl, 90, »BFS°); 
$xl « $xl +$Conf ig{Graph_Space) ; 

$Title_Bar -> stringTTF ($Black, a . /f onts/arial . ttf n , 30, 0, 

$xl, 90, »BVI1») ; 

$xl = $xl +$Conf ig{Graph__Space) ,* 

$Title_Bar -> stringTTF ($Black, " . /f onts/arial .ttf B , 30, 0, 

$xl, 90, "CEBP mutant") ; 



$Parent_Image -> copy ($Title_Bar, $Patient_ID_Width, 0, 

0, 0, $Width, 100); 

print "Just to remind you: the image created will be : « ■ , $Conf ig{Output_File} , D ' (you can 
alter the default by using 2nd command line argument) \n" ; 

$Parent_Image -> stringTTF ($Black, « ./f onts/arial .ttf ■ , 50, 3.142 / 2, 

$ Width - 100, 
$Height , 

"Orginal Correlation File: 'OConf ig{Correlation_File} « ") ; 
$Parent_Image -> stringTTF ($Black, n . /f onts/arial . ttf " , 50, 3.142 / 2, 

$Width - 40, 
$ Height , 

"This Image is: ' $Conf ig{Output_File} ' ■ ) ; 

birunode OUTPUT; 

open OUTPUT, ">$Conf ig{Output_File} B or die "Cannot open output file: ln , 
$Conf ig { Output_Fi le } , ■ 1 \n » ; 

print OUTPUT $Parent_JEmage -> png () ; #Thankfully OOi The difficult bit! 

close OUTPUT; #Will close anyway upon program exit 



# 

# 
# 

#Subroutines only below here .... 

#########SUB START 

sub D r a w_Ii i n e s_on__ I mag e { 

print «D: Ok, You wanted lines \n" ,- #Guess so 

my $x_max « $Conf ig{Block_Size} * $Max_Col; #Pre- calculate the right-hand edge 

my $y_raax = $Config{Block_Size} * $Row; #Pre- calculate the bottom edge. 

print n D: (Horizontal): 

foreach ray $row (0..$Row) #For all rows 

{ 

my $y = $Config{Block_Size} * $row; #Calculate the 'y» position 
$Image -> line (0, $y, $x_max, $y, $Black) ; #Draw Horizontal Line 

# printf («%Si »,$row); 

} 

print *\n u ; 

print "D: (Vertical): "; 
.foreach my $col (0. .$Max Col) #For all colourans 

{ 

my $x = $Config{Block_Size} * $col; #Calculate the 'x» position 
$Image -> line ($x, 0, $x, $y_max, $Black) ; #Draw Vertical Line 

# printf ("%5i ",$col); 

} 

print n \n n 
} 



#########SUB START 

sub Draw_Color__Stripe { 
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my $White = $Color_Stripe_XMG -> colorAllocate (255,0,255); #Sefc first color (also 

background color I ) 

my $Black = $Colcr_5tripe_IMG -> colorAllocate (0,0,0); #Allocate color 'Black' ,- 

print n D ; Color Stripe image is: 1 $Col_Stripe_Width x $Col_ Stripe_Heiglit ' \n" ; 
$Color_Stripe_IMG -> rectangle (1,1, $Colj5tripe_Width -1, $Col_Stripe_Height-l, $Black) ; 
#my $Image » new GD: : Image (1000,100); #HW: For testing Color Stripe... 

#ray ©Col or_S tripe ; 

#Colors run: Full Blue - Partial Blues - Full White - Partial Reds - Fvill Red 
#print n D: Allocate 'Blues': \n" ; 

my ®Color_Stripe_Bar; 

#Colors run: Full Blue - Partial Blues - Full White - Partial Reds - Full Red 
print M D: Allocate 'Blues': \n"; 

foreach ray $C_Color (0 . . ($Conf ig{Color_Strips}/2-l) ) #Run: Full Blue to one level 

below white 

{ 

printf ("%3i " , $C_Color) ; 

my $Blue_level = 255/ ($Config{ Col or_S trips } /2) *$C_Color; #The (complex) 
calculation for the color level 

# print "D: Allocating Color: Blue_level = • $Blue_level ' \n" ; #works for the 
red as well but without the "255-" part 

push @Color_Stripe_Bar, $Color_Stripe_IMG -> colorAllocate 
( $Blue_level , $Blue_level , 255 ) ; 

} 

print "D: Color__Stripe_Bar : , |©Color__Stripe_Bar| i.e. has: $#Color_Stripe__Bar +1 
divisions\n" ; 

#print "D: $#Color_Stripe, @Color__Stripe\n" ; #Note down 

the index of the color just allocated in a 'look-up' table 
#print "D: Allocating White: < As mid point >"; 

push @Color_Stripe_Bar, $Color_Stripe_IMG -> colorAllocate (255,255,255); #The 'White' is 
fixed. 

print "D: Color_Stripe_Bar : , |@Color_Stripe_Bar| i.e. has: $#Color_Str±pe_Bar +1 
divisions\n" ; 

#print "D: $#Color_Stripe , @Color_Stripe\n" ; 
print "\nD: Allocate 'Reds': \n" ; 

foreach my $C_Color (1 . . ($Conf ig{Color_Strips}/2) ) #Run: one above 'white' to full red 
{ 

printf ("%3i " , $C_Color) ; 

my $Red__level = 255 - 255/ ($Conf ig { Col or__S trips} /2) *$C_Color ; 

# print "D: Red_level - ' $Red_level ' \n B ; 

push ®Color_Stripe_Bar, $Color_Stripe_IMG -> colorAllocate 
(255, $Red_level , $Red_level) ; 

} 

print "\n n ; 

print "D: Color_Stripe_Bar: , | ©Color St ripe_Bar | i.e. has: $#Color_Stripe_Bar +1 
divisionaXn" ; 



print "D: Will use color: n ; 

foreach my $C_color ( 0 . . $#Color_Stripe Bar) 

{ 

printf (»%3i 11 , $C_color) ; 

# print "D: Drawing box: ' $C_color ' \n" ; 

my $X1 = ($C_color) * $Conf ig{Block_Size} * $Config {Scale } ; #Account for off- 

center scale: 3,4,5.. to 0,1,2 for plotting 

my $X2 = ($C_color +1) * $Conf ig{Block_Size} * $Config {Scale } ; 

# print "D: XI = »$X1', X2 = '$X2«, "; 

#print n D: Will use color = ' $Color_S tripe [$C_colorJ ' , i.e. A_color: $A_color; C_color: 
$C_color ; 

printf ( ■ %2i " , $C_color) ; 

$Color_stripe_IMG -> filledRect angle ($X1, 0 , $X2 , $Conf ig{Block_Size} * 
$Config{ Scale} , $Color__Stripe_Bar [$C_colorJ ) ; 

$Color_Stripe_IMG -> rectangle ($X1, 0 , $X2-1, $Conf ig{Block_Size} * 
$Conf ig {Scale }- 1, $Black) ; 

# $Color_Stripe_IMG -> stringTTF ($Black, 0 . /fonts/ arial .ttf° , 20, 0,$X1, 20, 
$C_color) ; 

} 
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#Highlight the middle part: of the scale: 
my $C_color = $#Color_Stripe/2 ; 
my $X1 = $C_color * $Conf ig{Block_Size} ; 
for plotting 

my $X2 o ($c_color +1) * $Conf ig{Block_Size} ; 



#Account for off-center scale: 3,4,5.. to 0,1,2 



#$Color_Stripe_IMG -> rectangle ($X1 + $Config {Scale }, 1, $X2 * 
$Config {Scale }, $Config{Block_Size} * $Conf ig{Scale} -2, $Black) ; 

#open OUTPUT, B >Color_Stripe.png" or die "Cannot open output file: ■ Color_S tripe .png' \n" ,- 

#print OUTPUT $Color_Stripe_IMG -> png () ; #Thankfully OO! The difficult bit! 

#close OUTPUT; #Will close anyway 

} 

#########SUB START 

#sub Draw_Classif ication_Stripe { 

#HEY ! This doesn't do anything! ! ! I 

#open OUTPUT, " >Classifi cat ion_S tripe .png" or die "Cannot open output file: 
1 Classif i cat ion_St ripe .png ' \n" ; 

#print OUTPUT $Classification_Stripe_IMG -> png () ; #Thankfully OO! The difficult 

bit! 

#close OUTPUT; #Will close anyway. . . 

#} 

#########SUB START 

sub Load_Conf iguration { 

#This loads configuration into the main Config hash array. Defaults are gi-ven first: 
$Conf ig{Block_Size) = 16; #The size (in Pixels) of each block. 

#File names: Hard Wired in version 1 1! 



$Config{Clinical_Data_File} 

2 3_0 7_2 003. csv n ; #The name 

$Conf ig { Output_Fi 1 e } 

final generated image. 

#Other parameters: 

$Config {Block_Iiines} 

the blocks 

dimensions 

$Config {Draw_Color_S tripe} 
$Config {Color_S trips} 
» Strip' 

$Config {Minimum} 
$ Config {Maximum} 
$Config {Scale} 

to $Block_Size of the Blocks in 
$Conf ig{Correlation_File} 

View all clustered columnsets 
$Conf ig{Correlation_File } 
$Conf igf Header_Col_l } 
$Conf ig(Header_Col_2 } 
$ Conf ig { He ader_Col_3 } 
# $Conf ig { Header_Col_4 } 
$Conf ig{Header_Col_5 } 
$ Conf ig { Header_Col_6 } 
$Conf ig{Header_Col_7 } 
$Conf ig{Header_Col__8 } 
$ Conf ig { Header_Col_9 } 



= " . /csv/Tabel AML clinical and molecular data 
of the Clinical Datafile (Comma delimited format) . 

= fl 4850utput -png" ; #3STame of the 

= n F"; #Whether to draw lines round trie (inside) of 

#NB: Reduces colored area by 1 pixel in both 

= "T" ; #Should a Key be prepared? 
a 40; #The number of intervening colors in the 

- -1; # Assumed rainmum of correlation data 
= +1; #Assumed rainmum of correlation data 

s= 5; #The multiplication factor for relative 

the Color Stripe 
= "./362 

. CSV" ; 

= ■ . / incoming/4 8 5genes . csv" ; 

= "FAB" ; 

= "WBC" ; 

= "FLT3 ITD"; 

= "FLT3 TKD"; 

= "OS"; 

a "efs"; 

= "EVT1"; 

= "CEBP mutant"; 

= "osi"; 



$Conf ig{Mark_Nulls} = "SPOT"; 

$Conf ig{Mark_Patient_Data) = "Y" ; 

$Config{Marked_Patient} = "XXXXXXXXXXXXXXXXX" ; Inserts a black 

line to demonstrated correspondence / registery between patient CC and classification type. 
$Config{ Labeled asses} = "Y" ; 
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$Con£ig{Second_Scale_Spacing} = $Conf ig{Block_Size} * 10; #The spacing between the 

first and the second scale... *10 sets this to -130% the length of the first scale 

$Ccnf ig{Low_Blood_Count) - 100; #These were set by MJM because they were "nice 

round numbers " they have no scientific justification 

$Config{Med_Blood__Count} » 150; # 

$Config{Hi_Blood_Count} =200; # 

$Conf ig{Blood__Count_Max} =300; # 

$Config{EFS_Max} = 166; 

$Conf ig{OS_Max} = 166; 

$Conf ig{Graph_Space} = 250; 

$Conf ig{Font_Size} = 15; 

#print "D: Reading Configuration Information from STDINrVn" ; 

#my $Keys_Read=0; 

#my <SSTDIN= <STDIN>; 

#if <$STDIN[0] eq ■■) {return;} 

#foreach (OSTDIN) 

# ( 

# chomp ( ) ; 

# unless (/=/) {die "Error reading cofiguration file: Pattern expected 
is : \n ' Parameter « Value 1 \nWhat was found was : ' $_' \n u ; } 

# s/ //g; #Kill all spaces 

# (ray $Key , my $Value) = split ("=■,$_}; 

# print "D: Key = »$Key' ; Value = 1 $Value • \n" ; 

# $Keys_Read ++; 

# } 

#print "D: Finished reading config file: In total ' $Keys_Read» extra parameters read\n" ; 
} 

#########SUB START 

sub Mark_Patient_Data { 

#Find number of Colors needed (i.e. find number of catergories: 

my $Black t= $image -> colorAllocate (0,0,0); 

my $Yellow = $Image -> colorAllocate (255,255,0); #M6 

my $Cyan = $Image -> colorAllocate (0,255,255); #M5 

my $Maroon - $ Image -> colorAllocate (176,48,96); #M4 

ray $Orange = $Image -> colorAllocate (255,165,0); #M3 

ray $Pink » $Image -> colorAllocate (255,105,180); #M2 

ray $D_Green = $Image -> colorAllocate (85,107,47); #M1 

ray $Green = $Image -> colorAllocate (0,255,0); #M0 

ray $Red = $ Image -> colorAllocate (255,0,0); 

my $Soft_Green = $Image -> colorAllocate (128,255,128); 

ray $Soft_Red = $Image -> colorAllocate (255,128,128); 

ray $Low=$Image -> colorAllocate (32,32,32); #12.5% Grey: Low Blood Cell count 

ray $Med=$Image -> colorAllocate (128,128,128); #50% Grey: Medium Blood Cell count 

my $Hi =$Image -> colorAllocate (214,214,214); #87.5% Grey: High Blood Cell count 

foreach my $row (0 . . $#Matrix) #Cycle through all rows 

{ 

ray ($xl, $yl, $x2, $y2) ; #$row; my $Y = $row; 

$xl = $Conf ig{Block_Size} * $row; $x2 = $xl + $Conf ig{Block_Size} ; #Top left to 
Bottom right of a square 

$yl «= $xl; $y2 = $yl + $Conf ig{Block_Size} -1 ; 

#This is the diagonals of the square .... 

ray $x_cent « int ( ($x2 - $xl ) /2) + $xl; my $y_cent » int ( ($y2 - $yl ) /2) + 
$yl; #The center might be useful ... calculation is over complex, but hey - it's standard! 

my $C_Class = $Classif ication_l{$Patient_ID{$row} } ; #Just a convenience 

really. . . . 

print "D: Classification of Patient ($Patient__ID{$row} ) #'$row' = ' $C_Class 1 \n" ; 
$Image -> f i 11 edRec tangle ($xl, $yl, $x2, $y2, $White) ; #Blank blocks on 

diagongal 

#print "D: $#Color_Str ipe , ©Col or_St ripe \n" ; #Note down 

the index of the color just allocated in a 'look-up' table 
#print "D: Allocating White: < As raid point >"; 



#Ok! This is where the logic begins... 
#Do classification #1: FAB Type: 
if ($C_Class «- m/Mx/) 

{ #Ie. A mixed system. . . 

#Draw Spot .... 

print "D: Mixed classification found - drawing spot\n" ; 
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# $ Image - > line ($xl , $yl , $x2 , $y2 , $Black) ; 

$ Image -> arc ($x_ceat, $y_cent , $Conf ig{Biock__size} , $Conf ig{Block_Size} , 0 

, 360 , $Black) ; 

$ Image -> fill ( $x_cent , $y_cent , $Black) ; 

print W D : Diagonal block runs: $xl, $yl through center at $x_cent, $y_cent 
to: $x2 f $y2\n°; 

} 

if ($C_Class eq nn ) 

{ #Ie. Missing Classification... 

print "D: Missing Classification: Drawing a cro3s\n" ; 
$ Image -> line ($xl, $yl, $x2 t $y2, $ Black) ; 
$Image -> line <$x2, $yl, $xl, $y2, $Black) ; 

# next ; #Basy eh? ( ; - ) 

) 

if ($C Class a- m/M/ and not $C_Class =~ m/Mx/) 

~{ 

my $Block_color; 

my $Catergory = substr ($C_Class, 1,1) ; 
print W D: Catergory = 1 $Catergory ' \n° ,- 

# $Block_color « $Cat_bottom_color + $Catergory; 

if ($Catergory == 6) { $Block_color = $Yellow; } 
if ($Catergory == 5) { $Block_color = $Cyan;} 
if ($Catergory == 4) { $Block_color = $Maroon;} 
if ($Catergory 3) { $Block_color = $Orange ; } 
if ($Catergory == 2) {$Block_color = $Pinlc;} 

if ($Catergory «== 1) { $Block_color = $D_Qreen;} 

if ($Catergory 0) { $Block_color « $Green? } 

print "D: Will use color: ' $Block_color 1 \n n ; 

$x2 = $xl + 20*$Catergory+$Conf ig{Block_Size} -1; 

$Image -> filledRec tangle <$xl, $yl, $x2 , $y-2, $Block_color) ; 

if ($Config{Label_Classes} eq "Y" ) 

{ 

$Image -> stringTTF ($Black, ■ . /fonts /Courier .ttf" , 15, 0, $x2+10, 

$y2, $Catergory) ; 

) 

$Patient_IDs -> stringTTF ($Black, « . /fonts/Courier . ttf ■ , $Conf ig{Font_Size} , 0, 1, 
$y2 , $ Pat ient_ID { $ row } ) ; 

if ($Patient_ID{$row} eq $Conf ig{Marked_Patient} ) #This is used to check 

the 'register' between the CC data and the Patient Classification. 

{ 

# my $Block_color = $Black; 

my $Catergory = substr ($C_ Class, 1,1); 

print n D: Marking Patient: ' $Patient_ID{$row} 1 using color: BLACK\n" ; 
my $Catergory = 10; 

$Image -> f illedRec tangle ($xl, $yl, $x2 + 20 * $Catergory r $y2, $Black) ; 

} 

#Now something similar for classification #2 (Blood Cell Count) : 

$xl=$xl + $Conf ig{Graph_Space} ; #ie. give some space between the two scales 

$x2 = $xl + $Conf ig{Block_Size} ; 

my $Blood_Count » $ciassif ication_2{$Patient_ID{$row} } ; 
print "D: Blood count « ' $Blood_Count ' \n" ; 
if ( $Blood_Count == undef) 

{ 

print °D: Missing Blood Count Classification: Drawing a cross\n° ; 
$lmage -> line ($xl, $yl, $x2, $y2, $Black) ; 
$ Image -> line ($x2, $yl, $xl, $y2, $Black) ; 

} 

else 

my $Bar_Length = $Blood__Count / $Conf ig{Blooc\__Count_Max} * 200; 
Draw_blood__bar ($Med, $Blood_ Count, $xl, $yl, $Bar_l*ength) ; 

> 

# $Conf ig { Blood_Count_Max } 

#Now something similar for classification #3 (FLT ITD) : 

$xls5$xl + $Conf ig{Graph_Space} ; #ie. give some space between the two scales 
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my $FT/T__Claes = $Classif ication_3{$Pafcient_ID{$row} } ; 

print "D: FLT3 Class = ? $FI.T_Class s for Patient: « $Patient_ID{$row} 1 \n" ; 
if {$FI*T_Class eq »") 

{ 

print °D: Missing FTL Classification: Drawing a cross\n n ; 

$x2 «= $xl + $Conf ig{Block_Size } ; 

$Image -> line ($xl, $yl, $x2, $y2, $Black) ; 

$ Image -> line ($x2, $yl, $xl, $y2, $Black) ; 

> 

else 

{ 

if ($FTiT_Class =- m/Pos/i or $FI*T_Class ra/Yes/i) 
{ 

$x2«=$xl + 150; 

$Iraage -> f illedRectangjle ($xl, $yl, $x2, $y2, $Sof t_ Red) ; 
$Image -> stringTTF ($Black, " . /fonts /Courier . ttf n , 
$Config{Font_Size} , 0, $x2+10, $y2-2, »Pos n ); 

} 

else ■ 

{ 

$x2s=$xl + 75; 

$ Image -> f illedRectangjle ($xl, $yl, $x2, $y2, $Soft_Green) ; 

$Image -> stringTTF ($Black, B . / fonts/Courier . ttf " , 
$Conf ig{Font_Size} , 0, $x2+l0, $y2-3, »Keg») ; 

} 

} 



#Now something similar for classification #5 (OS) : 

$xl=$xl + $Conf ig{Graph__Space} ; #ie . give some space between the two scales 

$x2 = $xl + $Conf ig{Block_Size} ; 

ray $OS = $Classif ication_5{$Patient_ID{$row} } ; 

print "D : OS = '$OS«\n n ; 

if ($OS eq nw ) 

{ 

print "D: Missing OS Classification: Drawing a cross\n n ; 
$Image -> line ($xl, $yl, $x2, $y2, $Black) ; 
$Image -> line <$x2, $yl, $xl, $y2, $Black) ; 

} 

else 

{ 

my $Bar_Length - $OS / $Conf ig {OSJMax} * 200; 
Draw_blood_bar <$Med, $OS,$xl, $yl, $Bar Length); 

} 

# $Conf ig { Blood_Count_Max } 

#Now something similar for classification #6 (EPS) : 

$xl*=$xl + $Conf ig{Graph_Space} ; #ie . give some space between the two scales 

$x2 = $xl + $Conf ig{Block_Size) ; 

my $EFS = $Classif ication_6 { $Patient_ID{ $row} } ; 

print B D: $Patient_XD{$row} EPS = ' $EFS 1 \n" ; 

if ($EFS eq "») 

{ 

print "D: Missing EPS Classification: Drawing a cross\n" ; 
$ Image -> line ($xl, $yl, $x2, $y2, $Black) ; 
$lmage -> line ($x2, $yi, $xl, $y2, $Black) ; 
} 

else 

{ 

print "D: Testing Dead/ alive status: 
• $Classification_9{$Patient_ID{$row} } f ■ *\n» ; 

my $Bar_Length = $EFS / $Conf ig{EFS__Max} * 200; 

if <$Classification_9{$Patient_ID{$row} } eq "alive") 

{Draw_blood_bar ($Sof t__Green, $EFS,$xl, $yl, $BarJLength) ; } 
else 

{Drawjblood_bar ($Soft_Red, $BFS,$xl, $yl, $Bar_Length) ; } 
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#Now something similar for classification #7 (EVI1) : 

$xl=$xl + $Config{Graph_Space} ; #io. give some space between the two scales 

my $EVIl_Class = $Classif ication_7{$Patient_ID{$row} } ; 

print "D: BVI1 Class = 1 $EVTl_Class 1 for Patient: ' $Patient_ID{$row} ' \n« ; 
if ($EVIl_Class eq na ) 

{ 

print "D: Missing EVT1 Classification: Drawing a cross\n"; 

$x2 = $xl + $Config{Block_Size) ; 

$Image -> line {$xi, $yl, $x2, $y2, $Black) ; 

$lmage -> line ($x2, $yl, $xl, $y2, $ Black) ; 

} 

else 

{ 

if ($EVI1 Class =- m/Pos/i or $EVI1 class — m/Yes/i) 
{ 

$x2=$xl + 150; 

$ Image -> f IlledRectangle {$xl f $yl, $x2, $y2, $Soft__Red) ; 
$Image -> stringTTF ($Black ( /fonts/Courier . ttf" , 
$Config{Font_Size} , 0, $x2+10, $y2-2, "Pos") ; 

} 

else 

{ 

$x2=$xl + 75 ; 

$Image -> f ill edRect angle ($xl, $yl, $x2, $y2, $Sof t_Green) ; 

$Image -> stringTTF ($Black, 11 . /fonts/Courier . ttf " , 
$Conf ig{Font_Size) , 0, $x2+10, $y2-3, "Neg") ; 

} 

} 

#CEBP mutant to go in I 

#Now something similar for classification #8 (CEBP) : 

$xl=$xl + $Conf ig{Graph_Space} ; #ie. give some space between the two scales 

my $CEBP_Claes = $Classif ication_8 { $Patient_ID{$row} } ; 

print n D: CEBP Class = ' $CEBP_Class 1 for Patient: • $Patient_ID{$row} » \n° ; 
if ($CEBP_Class eq Mn ) 

{ 

print "D: Missing CEBP Classification: Drawing a cross \n n ; 

$x2 » $xl + $Conf ig{Block_Size} ; 

$Image -> line ($xl, $yl, $x2, $y2, $Black) ; 

$Image -> line ($x2, $yl, $xl, $y2, $Black) ; 

} 

else 

{ 

if ($CEBP_Class =~ m/Pos/i or $CEBP Class ra/Yes/i) 

{ 

$x2«$xl + 150; 

$Image -> f illedRectangle ($xl, $yl, $x2, $y2, $Soft_Red) ; 
$Iraage -> stringTTF ($Black, /fonts/Courier . ttf" , 
$Config{Font_Size} , 0, $x2+10, $y2-2, "Pos"); 

} 

else 

{ 

$x2«$xl + 75; 

$Image -> f illedRectangle ($xl, $yl, $x2, $y2, $Sof tjGreen) ; 

$ Image - > stringTTF { $Black, n . /fonts/Courier . ttf » , 
$Config{Font_Size} , 0, $x2+10, $y2-3, "Neg") ? 

} 

} 

next; 

} 

#return ($Cat_bottom_color , $Number of colors) ; 

} 

sub Draw_blood_bar { 

(ray $color, my $Count, my $x, my $y, my $Length) » ®_; 

$lmage -> f illedRectangle <$x, $y, $x + *" " " - Size}-1, $color) ; 

Figure 15n 
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$Iraage -> stringTTP (l, » . /fonts/Courier .ttf tt , $Conf ig{Font_Size) , 0, $x + $Length + 10, $y 
+ $Conf ig{Block_Size}-l, int ($Count) ) ; 

} 

################START SUB 

#sub Draw_Classif i cat ion__S tripe { 

#Er? Finishing this would be a good idea .... 

#Hey! This doesn't do anything! 

#for my $C_Class (1. .$Classes) 

» { 



# } 



sub Label_Class { 

(ray $x, my $y , my $Cat) = ©_; 

print "D: LABEL_CLASS: Got the data: [X,Y,Cat] »$x» , ^y', '$Cat' passed\n» ; 
} 

sub Top_Color_Print { 

print "D: [Allocating new color of index: ' $Top_Color 1 ] \n" ; 

$Top_Color ++; 

} 

sub Allocate_Catergory_range { 
my %C1 asses; 

my $Number_of _Cl as se s = 0 ; 

for each my $C_Patient (keys %Class±f ication_l) #Cycle through all 

classifications 

{ 

# print "D: Classification of Patient: ' $C_Patient ' = 

' $Classif ication_l { $C_Patient } • \n" 

unless (exists $Classes{ $Classif ication_l{$C_Patient } } ) #Check whether this 
classification has been seen before. 

{ #Ok, it hasn't: 

print H D: Found new Class: ' $Classif ication_l{$C_Patient} 1 \n* ; 

$Classes{$Classif ication_l{$C_Patient} } = $Classif ication_l{$C_Patient} ; 

#Add it to the Hash Array 

$Number_of_Classes #Add 1 to the tally of classes 



print "D: Number of FAB Classes (patient catergories) = 1 $Number_of_Cl asses ' \n" ; #Useful to 
know 

print "D: Allocate 'Catergory Colors': \n" ; 

my $CC_max_color <= $#Color_S tripe; 

my $Cat_Jbottom_color = $CC_max_color + 3; 

print "D: Last Color Allocated for CC Matrix: $CC__raax_color 1 $Cat_bottom__color 1 \n» ; 
my $Number__of_colors = $Number__of_Cl asses - 3; 

foreach my $C Color (0..$Number of colors) #Ie, pickup where the CC data left off 
{ 

printf ("%3i " , $C__Color) ; 

my $Red — level = int (255 / $Number__of_colors * $C_Color) ; #The (complex) 
calculation for the color level 

print n D: For $C_Color: Red_JLevel (needed to alter Green to Yellow) = 1 $Red_level 1 , 
i.e. Color :", ($C_Color+$Cat_bottom__color) , "\n" ; #works for the red as well but 

without the "255-" part 
# push @Color_S tripe, 

$Image -> colorAllocate ($Red level , 255, 0) ; 

} 

my $Cat_top__color = $# Co lor_S tripe ; #Don't think this is actually used. . .nice to 

know though 1 

print "D: Catergory colors will range from: $Cat_bottom_color to • " , $Cat_bottom_color + 
$Number_pf __colors , n 1 \n w ; 

} 
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